home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / comint / shell.el.z / shell.el
Encoding:
Text File  |  1998-05-21  |  38.5 KB  |  972 lines
  1. ;;; shell.el --- specialized comint.el for running the shell.
  2.  
  3. ;; Copyright (C) 1988, 1993, 1994, 1995 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Olin Shivers <shivers@cs.cmu.edu>
  6. ;; Maintainer: Simon Marshall <simon@gnu.ai.mit.edu>
  7. ;; Keywords: processes
  8.  
  9. ;; This file is part of XEmacs.
  10.  
  11. ;; XEmacs is free software; you can redistribute it and/or modify it
  12. ;; under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; XEmacs is distributed in the hope that it will be useful, but
  17. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19. ;; General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with XEmacs; see the file COPYING.  If not, write to the 
  23. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24. ;; Boston, MA 02111-1307, USA.
  25.  
  26. ;;; Synched up with: FSF 19.30.
  27.  
  28. ;;; Commentary:
  29.  
  30. ;;; Please send me bug reports, bug fixes, and extensions, so that I can
  31. ;;; merge them into the master source.
  32. ;;;     - Olin Shivers (shivers@cs.cmu.edu)
  33. ;;;     - Simon Marshall (simon@gnu.ai.mit.edu)
  34.  
  35. ;;; This file defines a a shell-in-a-buffer package (shell mode) built
  36. ;;; on top of comint mode.  This is actually cmushell with things
  37. ;;; renamed to replace its counterpart in Emacs 18.  cmushell is more
  38. ;;; featureful, robust, and uniform than the Emacs 18 version.
  39.  
  40. ;;; Since this mode is built on top of the general command-interpreter-in-
  41. ;;; a-buffer mode (comint mode), it shares a common base functionality, 
  42. ;;; and a common set of bindings, with all modes derived from comint mode.
  43. ;;; This makes these modes easier to use.
  44.  
  45. ;;; For documentation on the functionality provided by comint mode, and
  46. ;;; the hooks available for customising it, see the file comint.el.
  47. ;;; For further information on shell mode, see the comments below.
  48.  
  49. ;;; Needs fixin:
  50. ;;; When sending text from a source file to a subprocess, the process-mark can 
  51. ;;; move off the window, so you can lose sight of the process interactions.
  52. ;;; Maybe I should ensure the process mark is in the window when I send
  53. ;;; text to the process? Switch selectable?
  54.  
  55. ;; YOUR .EMACS FILE
  56. ;;=============================================================================
  57. ;; Some suggestions for your .emacs file.
  58. ;;
  59. ;; ;; Define M-# to run some strange command:
  60. ;; (eval-after-load "shell"
  61. ;;  '(define-key shell-mode-map "\M-#" 'shells-dynamic-spell))
  62.  
  63. ;;; Brief Command Documentation:
  64. ;;;============================================================================
  65. ;;; Comint Mode Commands: (common to shell and all comint-derived modes)
  66. ;;;
  67. ;;; m-p        comint-previous-input            Cycle backwards in input history
  68. ;;; m-n        comint-next-input                  Cycle forwards
  69. ;;; m-r     comint-previous-matching-input  Previous input matching a regexp
  70. ;;; m-s     comint-next-matching-input      Next input that matches
  71. ;;; m-c-l   comint-show-output            Show last batch of process output
  72. ;;; return  comint-send-input
  73. ;;; c-d        comint-delchar-or-maybe-eof        Delete char unless at end of buff.
  74. ;;; c-c c-a comint-bol                      Beginning of line; skip prompt
  75. ;;; c-c c-u comint-kill-input                ^u
  76. ;;; c-c c-w backward-kill-word            ^w
  77. ;;; c-c c-c comint-interrupt-subjob         ^c
  78. ;;; c-c c-z comint-stop-subjob                ^z
  79. ;;; c-c c-\ comint-quit-subjob                ^\
  80. ;;; c-c c-o comint-kill-output            Delete last batch of process output
  81. ;;; c-c c-r comint-show-output            Show last batch of process output
  82. ;;; c-c c-h comint-dynamic-list-input-ring  List input history
  83. ;;;         send-invisible                  Read line w/o echo & send to proc
  84. ;;;         comint-continue-subjob        Useful if you accidentally suspend
  85. ;;;                            top-level job
  86. ;;; comint-mode-hook is the comint mode hook.
  87.  
  88. ;;; Shell Mode Commands:
  89. ;;;         shell            Fires up the shell process
  90. ;;; tab     comint-dynamic-complete    Complete filename/command/history
  91. ;;; m-?     comint-dynamic-list-filename-completions
  92. ;;;                    List completions in help buffer
  93. ;;; m-c-f   shell-forward-command    Forward a shell command
  94. ;;; m-c-b   shell-backward-command    Backward a shell command
  95. ;;;         shell-resync-dirs        Resync the buffer's dir stack
  96. ;;;         dirtrack-toggle        Turn dir tracking on/off
  97. ;;;         comint-strip-ctrl-m        Remove trailing ^Ms from output
  98. ;;;
  99. ;;; The shell mode hook is shell-mode-hook
  100. ;;; comint-prompt-regexp is initialised to shell-prompt-pattern, for backwards
  101. ;;; compatibility.
  102.  
  103. ;;; Read the rest of this file for more information.
  104.  
  105. ;;; Customization and Buffer Variables
  106. ;;; ===========================================================================
  107. ;;; 
  108.  
  109. ;;; Code:
  110.  
  111. (require 'comint)
  112.  
  113. (defgroup shell nil
  114.   "Running shell from within Emacs buffers"
  115.   :group 'processes
  116.   :group 'unix)
  117.  
  118. (defgroup shell-directories nil
  119.   "Directory support in shell mode"
  120.   :group 'shell)
  121.  
  122. (defgroup shell-faces nil
  123.   "Faces in shell buffers"
  124.   :group 'shell)
  125.  
  126. ;;;###autoload
  127. (defvar shell-prompt-pattern (purecopy "^[^#$%>\n]*[#$%>] *")
  128.   "Regexp to match prompts in the inferior shell.
  129. Defaults to \"^[^#$%>\\n]*[#$%>] *\", which works pretty well.
  130. This variable is used to initialise `comint-prompt-regexp' in the
  131. shell buffer.
  132.  
  133. The pattern should probably not match more than one line.  If it does,
  134. shell-mode may become confused trying to distinguish prompt from input
  135. on lines which don't start with a prompt.
  136.  
  137. This is a fine thing to set in your `.emacs' file.")
  138.  
  139. (defcustom shell-completion-fignore nil
  140.   "*List of suffixes to be disregarded during file/command completion.
  141. This variable is used to initialize `comint-completion-fignore' in the shell
  142. buffer.  The default is nil, for compatibility with most shells.
  143. Some people like (\"~\" \"#\" \"%\").
  144.  
  145. This is a fine thing to set in your `.emacs' file."
  146.   :type '(repeat (string :tag "Suffix"))
  147.   :group 'shell)
  148.  
  149. ;jwz: turned this off; it's way too broken.
  150. (defvar shell-delimiter-argument-list nil ;'(?\| ?& ?< ?> ?\( ?\) ?\;
  151.   "List of characters to recognise as separate arguments.
  152. This variable is used to initialize `comint-delimiter-argument-list' in the
  153. shell buffer.  The default is (?\\| ?& ?< ?> ?\\( ?\\) ?\\;).
  154.  
  155. This is a fine thing to set in your `.emacs' file.")
  156.  
  157. (defvar shell-file-name-quote-list
  158.   (append shell-delimiter-argument-list '(?\  ?\* ?\! ?\" ?\' ?\`))
  159.   "List of characters to quote when in a file name.
  160. This variable is used to initialize `comint-file-name-quote-list' in the
  161. shell buffer.  The default is (?\  ?\* ?\! ?\" ?\' ?\`) plus characters
  162. in `shell-delimiter-argument-list'.
  163.  
  164. This is a fine thing to set in your `.emacs' file.")
  165.  
  166. (defvar shell-dynamic-complete-functions
  167.   '(comint-replace-by-expanded-history
  168.     shell-dynamic-complete-environment-variable
  169.     shell-dynamic-complete-command
  170.     shell-replace-by-expanded-directory
  171.     comint-dynamic-complete-filename)
  172.   "List of functions called to perform completion.
  173. This variable is used to initialise `comint-dynamic-complete-functions' in the
  174. shell buffer.
  175.  
  176. This is a fine thing to set in your `.emacs' file.")
  177.  
  178. (defcustom shell-command-regexp "[^;&|\n]+"
  179.   "*Regexp to match a single command within a pipeline.
  180. This is used for directory tracking and does not do a perfect job."
  181.   :type 'regexp
  182.   :group 'shell)
  183.  
  184. (defcustom shell-completion-execonly t
  185.   "*If non-nil, use executable files only for completion candidates.
  186. This mirrors the optional behavior of tcsh.
  187.  
  188. Detecting executability of files may slow command completion considerably."
  189.   :type 'boolean
  190.   :group 'shell)
  191.  
  192. (defcustom shell-multiple-shells nil
  193.   "*If non-nil, each time shell mode is invoked, a new shell is made"
  194.   :type 'boolean
  195.   :group 'shell)
  196.  
  197. (defcustom shell-popd-regexp "popd"
  198.   "*Regexp to match subshell commands equivalent to popd."
  199.   :type 'regexp
  200.   :group 'shell-directories)
  201.  
  202. (defcustom shell-pushd-regexp "pushd"
  203.   "*Regexp to match subshell commands equivalent to pushd."
  204.   :type 'regexp
  205.   :group 'shell-directories)
  206.  
  207. (defcustom shell-pushd-tohome nil
  208.   "*If non-nil, make pushd with no arg behave as \"pushd ~\" (like cd).
  209. This mirrors the optional behavior of tcsh."
  210.   :type 'boolean
  211.   :group 'shell-directories)
  212.  
  213. (defcustom shell-pushd-dextract nil
  214.   "*If non-nil, make \"pushd +n\" pop the nth dir to the stack top.
  215. This mirrors the optional behavior of tcsh."
  216.   :type 'boolean
  217.   :group 'shell-directories)
  218.  
  219. (defcustom shell-pushd-dunique nil
  220.   "*If non-nil, make pushd only add unique directories to the stack.
  221. This mirrors the optional behavior of tcsh."
  222.   :type 'boolean
  223.   :group 'shell-directories)
  224.  
  225. (defcustom shell-cd-regexp "cd"
  226.   "*Regexp to match subshell commands equivalent to cd."
  227.   :type 'regexp
  228.   :group 'shell-directories)
  229.  
  230. (defcustom explicit-shell-file-name nil
  231.   "*If non-nil, is file name to use for explicitly requested inferior shell."
  232.   :type '(choice (const :tag "None" nil) file)
  233.   :group 'shell)
  234.  
  235. (defcustom explicit-csh-args
  236.   (if (eq system-type 'hpux)
  237.       ;; -T persuades HP's csh not to think it is smarter
  238.       ;; than us about what terminal modes to use.
  239.       '("-i" "-T")
  240.     '("-i"))
  241.   "*Args passed to inferior shell by M-x shell, if the shell is csh.
  242. Value is a list of strings, which may be nil."
  243.   :type '(repeat (string :tag "Argument"))
  244.   :group 'shell)
  245.  
  246. (defcustom shell-input-autoexpand 'history
  247.   "*If non-nil, expand input command history references on completion.
  248. This mirrors the optional behavior of tcsh (its autoexpand and histlit).
  249.  
  250. If the value is `input', then the expansion is seen on input.
  251. If the value is `history', then the expansion is only when inserting
  252. into the buffer's input ring.  See also `comint-magic-space' and
  253. `comint-dynamic-complete'.
  254.  
  255. This variable supplies a default for `comint-input-autoexpand',
  256. for Shell mode only."
  257.   :type '(choice (const nil) (const input) (const history))
  258.   :type 'shell)
  259.  
  260. (defvar shell-dirstack nil
  261.   "List of directories saved by pushd in this buffer's shell.
  262. Thus, this does not include the shell's current directory.")
  263.  
  264. (defvar shell-dirtrackp t
  265.   "Non-nil in a shell buffer means directory tracking is enabled.")
  266.  
  267. (defvar shell-last-dir nil
  268.   "Keep track of last directory for ksh `cd -' command.")
  269.  
  270. (defvar shell-dirstack-query nil
  271.   "Command used by `shell-resync-dirs' to query the shell.")
  272.  
  273. (defvar shell-mode-map nil)
  274. (if (not shell-mode-map)
  275.     (let ((map (make-keymap)))
  276.       (set-keymap-parents map (list comint-mode-map))
  277.       (set-keymap-name map 'shell-mode-map)
  278.       (define-key map "\C-c\C-f" 'shell-forward-command)
  279.       (define-key map "\C-c\C-b" 'shell-backward-command)
  280.       (define-key map "\t" 'comint-dynamic-complete)
  281.       (define-key map "\M-?"  'comint-dynamic-list-filename-completions)
  282.       ;; XEmacs: this is a pretty common operation for those of us
  283.       ;; who use directory aliases ...  someone shoot me if they
  284.       ;; don't like this binding.  Another possibility is C-c C-s
  285.       ;; but that's way awkward.
  286.       ;; July-5-1997, Bang! -slb
  287.       #-infodock (define-key map "\M-\C-m" 'shell-resync-dirs)
  288.       (setq shell-mode-map map)))
  289.  
  290. (defcustom shell-mode-hook nil
  291.   "*Hook for customising Shell mode."
  292.   :type 'hook
  293.   :group 'shell)
  294.  
  295.  
  296. ;; font-locking
  297. (defcustom shell-prompt-face 'shell-prompt-face
  298.   "Face for shell prompts."
  299.   :type 'face
  300.   :group 'shell-faces)
  301. (defcustom shell-option-face 'shell-option-face
  302.   "Face for command line options."
  303.   :type 'face
  304.   :group 'shell-faces)
  305. (defcustom shell-output-face 'shell-output-face
  306.   "Face for generic shell output."
  307.   :type 'face
  308.   :group 'shell-faces)
  309. (defcustom shell-output-2-face 'shell-output-2-face
  310.   "Face for grep-like output."
  311.   :type 'face
  312.   :group 'shell-faces)
  313. (defcustom shell-output-3-face 'shell-output-3-face
  314.   "Face for [N] output where N is a number."
  315.   :type 'face
  316.   :group 'shell-faces)
  317.  
  318. (make-face shell-prompt-face)
  319. (make-face shell-option-face)
  320. (make-face shell-output-face)
  321. (make-face shell-output-2-face)
  322. (make-face shell-output-3-face)
  323.  
  324. (defun shell-font-lock-mode-hook ()
  325.   (or (face-differs-from-default-p shell-prompt-face)
  326.       (copy-face 'font-lock-keyword-face shell-prompt-face))
  327.   (or (face-differs-from-default-p shell-option-face)
  328.       (copy-face 'font-lock-comment-face shell-option-face))
  329.   (or (face-differs-from-default-p shell-output-face)
  330.       (copy-face 'italic shell-output-face))
  331.   (or (face-differs-from-default-p shell-output-2-face)
  332.       (copy-face 'font-lock-string-face shell-output-2-face))
  333.   (or (face-differs-from-default-p shell-output-3-face)
  334.       (copy-face 'font-lock-string-face shell-output-3-face))
  335.   ;; we only need to do this once
  336.   (remove-hook 'font-lock-mode-hook 'shell-font-lock-mode-hook))
  337. (add-hook 'font-lock-mode-hook 'shell-font-lock-mode-hook)
  338.  
  339. (defvar shell-prompt-pattern-for-font-lock nil
  340.   "If non-nil, pattern to use to font-lock the prompt.
  341. When nil, shell-prompt-pattern will be used.  Set this to a regular
  342. expression if you want the font-locked pattern to be different then
  343. the shell's prompt pattern.")
  344.  
  345. (defvar shell-font-lock-keywords
  346.   (list '(eval . (cons (if shell-prompt-pattern-for-font-lock
  347.                shell-prompt-pattern-for-font-lock
  348.              shell-prompt-pattern)
  349.                shell-prompt-face))
  350.     '("[ \t]\\([+-][^ \t\n>]+\\)" 1 shell-option-face)
  351.     '("^[^ \t\n]+:.*" . shell-output-2-face)
  352.     '("^\\[[1-9][0-9]*\\]" . shell-output-3-face)
  353.     '("^[^\n]+.*$" . shell-output-face))
  354.   "Additional expressions to highlight in Shell mode.")
  355. (put 'shell-mode 'font-lock-defaults '(shell-font-lock-keywords t))
  356.  
  357.  
  358. ;;; Basic Procedures
  359. ;;; ===========================================================================
  360. ;;;
  361.  
  362. (defun shell-mode ()
  363.   "Major mode for interacting with an inferior shell.
  364. \\<shell-mode-map>\\[comint-send-input] after the end of the process' output sends the text from
  365.     the end of process to the end of the current line.
  366. \\[comint-send-input] before end of process output copies the current line minus the
  367.     prompt to the end of the buffer and sends it (\\[comint-copy-old-input] just copies
  368.     the current line).
  369. \\[send-invisible] reads a line of text without echoing it, and sends it to
  370.     the shell.  This is useful for entering passwords.  Or, add the function
  371.     `comint-watch-for-password-prompt' to `comint-output-filter-functions'.
  372.  
  373. If you want to make multiple shell buffers, rename the `*shell*' buffer
  374. using \\[rename-buffer] or \\[rename-uniquely] and start a new shell.
  375.  
  376. If you want to make shell buffers limited in length, add the function
  377. `comint-truncate-buffer' to `comint-output-filter-functions'.
  378.  
  379. If you accidentally suspend your process, use \\[comint-continue-subjob]
  380. to continue it.
  381.  
  382. `cd', `pushd' and `popd' commands given to the shell are watched by Emacs to
  383. keep this buffer's default directory the same as the shell's working directory.
  384. While directory tracking is enabled, the shell's working directory is displayed
  385. by \\[list-buffers] or \\[mouse-buffer-menu] in the `File' field.
  386. \\[shell-resync-dirs] queries the shell and resyncs Emacs' idea of what the
  387.     current directory stack is.
  388. \\[shell-dirtrack-toggle] turns directory tracking on and off.
  389.  
  390. \\{shell-mode-map}
  391. Customization: Entry to this mode runs the hooks on `comint-mode-hook' and
  392. `shell-mode-hook' (in that order).  Before each input, the hooks on
  393. `comint-input-filter-functions' are run.  After each shell output, the hooks
  394. on `comint-output-filter-functions' are run.
  395.  
  396. Variable `shell-multiple-shells' will automatically generate a new shell each
  397. time it is invoked.
  398.  
  399. Variables `shell-cd-regexp', `shell-pushd-regexp' and `shell-popd-regexp'
  400. are used to match their respective commands, while `shell-pushd-tohome',
  401. `shell-pushd-dextract' and `shell-pushd-dunique' control the behavior of the
  402. relevant command.
  403.  
  404. Variables `comint-completion-autolist', `comint-completion-addsuffix',
  405. `comint-completion-recexact' and `comint-completion-fignore' control the
  406. behavior of file name, command name and variable name completion.  Variable
  407. `shell-completion-execonly' controls the behavior of command name completion.
  408. Variable `shell-completion-fignore' is used to initialise the value of
  409. `comint-completion-fignore'.
  410.  
  411. Variables `comint-input-ring-file-name' and `comint-input-autoexpand' control
  412. the initialisation of the input ring history, and history expansion.
  413.  
  414. Variables `comint-output-filter-functions', a hook, and
  415. `comint-scroll-to-bottom-on-input' and `comint-scroll-to-bottom-on-output'
  416. control whether input and output cause the window to scroll to the end of the
  417. buffer."
  418.   (interactive)
  419.   (comint-mode)
  420.   (setq major-mode 'shell-mode)
  421.   (setq mode-name "Shell")
  422.   (use-local-map shell-mode-map)
  423.   (make-local-variable 'comint-prompt-regexp)
  424.   (setq comint-prompt-regexp shell-prompt-pattern)
  425.   (setq comint-completion-fignore shell-completion-fignore)
  426.   (make-local-variable 'comint-delimiter-argument-list)
  427.   (setq comint-delimiter-argument-list shell-delimiter-argument-list)
  428.   (make-local-variable 'comint-after-partial-filename-command)
  429.   (setq comint-after-partial-filename-command 'shell-after-partial-filename)
  430.   (make-local-variable 'comint-get-current-command)
  431.   (setq comint-get-current-command 'shell-get-current-command)
  432.   (make-local-variable 'comint-dynamic-complete-command-command)
  433.   (setq comint-dynamic-complete-command-command 'shell-dynamic-complete-command)
  434.   (setq comint-file-name-quote-list shell-file-name-quote-list)
  435.   (setq comint-dynamic-complete-functions shell-dynamic-complete-functions)
  436.   (make-local-variable 'paragraph-start)
  437.   (setq paragraph-start comint-prompt-regexp)
  438.   (make-local-variable 'shell-dirstack)
  439.   (setq shell-dirstack nil)
  440.   (make-local-variable 'shell-last-dir)
  441.   (setq shell-last-dir nil)
  442.   (make-local-variable 'shell-dirtrackp)
  443.   (setq shell-dirtrackp t)
  444.   (add-hook 'comint-input-filter-functions 'shell-directory-tracker nil t)
  445.   (setq comint-input-autoexpand shell-input-autoexpand)
  446.   (make-local-variable 'list-buffers-directory)
  447.   (setq list-buffers-directory (expand-file-name default-directory))
  448.   ;; shell-dependent assignments.
  449.   (let ((shell (file-name-nondirectory (car
  450.          (process-command (get-buffer-process (current-buffer)))))))
  451.     (setq comint-input-ring-file-name
  452.       (or (getenv "HISTFILE")
  453.           (cond ((string-equal shell "bash") "~/.bash_history")
  454.             ((string-equal shell "ksh") "~/.sh_history")
  455.             (t "~/.history"))))
  456.     (if (or (equal comint-input-ring-file-name "")
  457.         (equal (file-truename comint-input-ring-file-name) "/dev/null"))
  458.     (setq comint-input-ring-file-name nil))
  459.     (setq shell-dirstack-query
  460.       (if (string-match "^k?sh$" shell) "pwd" "dirs")))
  461.   (run-hooks 'shell-mode-hook)
  462.   (comint-read-input-ring t)
  463.   (shell-dirstack-message))
  464.  
  465.  
  466. ;;;###autoload
  467. (defun shell ()
  468.   "Run an inferior shell, with I/O through buffer *shell*.
  469. If buffer exists but shell process is not running, make new shell.
  470. If buffer exists and shell process is running, 
  471.  just switch to buffer `*shell*'.
  472. Program used comes from variable `explicit-shell-file-name',
  473.  or (if that is nil) from the ESHELL environment variable,
  474.  or else from SHELL if there is no ESHELL.
  475. If a file `~/.emacs_SHELLNAME' exists, it is given as initial input
  476.  (Note that this may lose due to a timing error if the shell
  477.   discards input when it starts up.)
  478. The buffer is put in Shell mode, giving commands for sending input
  479. and controlling the subjobs of the shell.  See `shell-mode'.
  480. See also the variable `shell-prompt-pattern'.
  481.  
  482. The shell file name (sans directories) is used to make a symbol name
  483. such as `explicit-csh-args'.  If that symbol is a variable,
  484. its value is used as a list of arguments when invoking the shell.
  485. Otherwise, one argument `-i' is passed to the shell.
  486.  
  487. \(Type \\[describe-mode] in the shell buffer for a list of commands.)"
  488.   (interactive)
  489.   (let ((buffer "*shell*")
  490.     (buffer-name (if shell-multiple-shells
  491.              "*shell*"
  492.                "shell")))
  493.   (cond ((or shell-multiple-shells
  494.          (not (comint-check-proc buffer)))
  495.      (let* ((prog (or explicit-shell-file-name
  496.               (getenv "ESHELL")
  497.               (getenv "SHELL")
  498.               "/bin/sh"))             
  499.         (name (file-name-nondirectory prog))
  500.         (startfile (concat "~/.emacs_" name))
  501.         (xargs-name (intern-soft (concat "explicit-" name "-args"))))
  502.        (setq buffer (set-buffer (apply 'make-comint buffer-name prog
  503.                        (if (file-exists-p startfile)
  504.                            startfile)
  505.                        (if (and xargs-name
  506.                             (boundp xargs-name))
  507.                            (symbol-value xargs-name)
  508.                          '("-i")))))
  509.        (shell-mode))))
  510.   (pop-to-buffer buffer)
  511.   (if shell-multiple-shells
  512.       (rename-buffer (generate-new-buffer-name "*shell*")))
  513.   ))
  514.  
  515. ;;; Don't do this when shell.el is loaded, only while dumping.
  516. ;;;###autoload (add-hook 'same-window-buffer-names "*shell*")
  517.  
  518. ;;; Directory tracking
  519. ;;; ===========================================================================
  520. ;;; This code provides the shell mode input sentinel
  521. ;;;     SHELL-DIRECTORY-TRACKER
  522. ;;; that tracks cd, pushd, and popd commands issued to the shell, and
  523. ;;; changes the current directory of the shell buffer accordingly.
  524. ;;;
  525. ;;; This is basically a fragile hack, although it's more accurate than
  526. ;;; the version in Emacs 18's shell.el. It has the following failings:
  527. ;;; 1. It doesn't know about the cdpath shell variable.
  528. ;;; 2. It cannot infallibly deal with command sequences, though it does well
  529. ;;;    with these and with ignoring commands forked in another shell with ()s.
  530. ;;; 3. More generally, any complex command is going to throw it. Otherwise,
  531. ;;;    you'd have to build an entire shell interpreter in emacs lisp.  Failing
  532. ;;;    that, there's no way to catch shell commands where cd's are buried
  533. ;;;    inside conditional expressions, aliases, and so forth.
  534. ;;;
  535. ;;; The whole approach is a crock. Shell aliases mess it up. File sourcing
  536. ;;; messes it up. You run other processes under the shell; these each have
  537. ;;; separate working directories, and some have commands for manipulating
  538. ;;; their w.d.'s (e.g., the lcd command in ftp). Some of these programs have
  539. ;;; commands that do *not* affect the current w.d. at all, but look like they
  540. ;;; do (e.g., the cd command in ftp).  In shells that allow you job
  541. ;;; control, you can switch between jobs, all having different w.d.'s. So
  542. ;;; simply saying %3 can shift your w.d..
  543. ;;;
  544. ;;; The solution is to relax, not stress out about it, and settle for
  545. ;;; a hack that works pretty well in typical circumstances. Remember
  546. ;;; that a half-assed solution is more in keeping with the spirit of Unix, 
  547. ;;; anyway. Blech.
  548. ;;;
  549. ;;; One good hack not implemented here for users of programmable shells
  550. ;;; is to program up the shell w.d. manipulation commands to output
  551. ;;; a coded command sequence to the tty. Something like
  552. ;;;     ESC | <cwd> |
  553. ;;; where <cwd> is the new current working directory. Then trash the
  554. ;;; directory tracking machinery currently used in this package, and
  555. ;;; replace it with a process filter that watches for and strips out
  556. ;;; these messages.
  557.  
  558. (defun shell-directory-tracker (str)
  559.   "Tracks cd, pushd and popd commands issued to the shell.
  560. This function is called on each input passed to the shell.
  561. It watches for cd, pushd and popd commands and sets the buffer's
  562. default directory to track these commands.
  563.  
  564. You may toggle this tracking on and off with \\[shell-dirtrack-toggle].
  565. If emacs gets confused, you can resync with the shell
  566. with \\[shell-resync-dirs].
  567.  
  568. See variables `shell-cd-regexp', `shell-pushd-regexp', and `shell-popd-regexp',
  569. while `shell-pushd-tohome', `shell-pushd-dextract' and `shell-pushd-dunique'
  570. control the behavior of the relevant command.
  571.  
  572. Environment variables are expanded, see function `substitute-in-file-name'."
  573.   (if shell-dirtrackp
  574.       ;; We fail gracefully if we think the command will fail in the shell.
  575.       (condition-case err
  576.       (let ((start (progn (string-match "^[; \t]*" str) ; skip whitespace
  577.                   (match-end 0)))
  578.         end cmd arg1)
  579.         (while (string-match shell-command-regexp str start)
  580.           (setq end (match-end 0)
  581.             cmd (comint-arguments (substring str start end) 0 0)
  582.             arg1 (comint-arguments (substring str start end) 1 1))
  583.           (cond ((string-match (concat "\\`\\(" shell-popd-regexp
  584.                        "\\)\\($\\|[ \t]\\)")
  585.                    cmd)
  586.              (shell-process-popd (substitute-in-file-name arg1)))
  587.             ((string-match (concat "\\`\\(" shell-pushd-regexp
  588.                        "\\)\\($\\|[ \t]\\)")
  589.                    cmd)
  590.              (shell-process-pushd (substitute-in-file-name arg1)))
  591.             ((string-match (concat "\\`\\(" shell-cd-regexp
  592.                        "\\)\\($\\|[ \t]\\)")
  593.                    cmd)
  594.              (shell-process-cd (substitute-in-file-name arg1))))
  595.           (setq start (progn (string-match "[; \t]*" str end) ; skip again
  596.                  (match-end 0)))))
  597.     (error
  598.      ;; XEmacs change
  599.      (message nil)
  600.      (display-error err t)))))
  601.  
  602. ;; Like `cd', but prepends comint-file-name-prefix to absolute names.
  603. (defun shell-cd-1 (dir dirstack)
  604.   (if shell-dirtrackp
  605.       (setq list-buffers-directory (file-name-as-directory
  606.                     (expand-file-name dir))))
  607.   (condition-case nil
  608.       (progn (if (file-name-absolute-p dir)
  609.                  (cd-absolute (concat comint-file-name-prefix dir))
  610.                  (cd dir))
  611.              (setq shell-dirstack dirstack)
  612.              (shell-dirstack-message))
  613.     (file-error (message "Couldn't cd."))))
  614.  
  615. ;;; popd [+n]
  616. (defun shell-process-popd (arg)
  617.   (let ((num (or (shell-extract-num arg) 0)))
  618.     (cond ((and num (= num 0) shell-dirstack)
  619.            (shell-cd-1 (car shell-dirstack) (cdr shell-dirstack)))
  620.       ((and num (> num 0) (<= num (length shell-dirstack)))
  621.        (let* ((ds (cons nil shell-dirstack))
  622.           (cell (nthcdr (1- num) ds)))
  623.          (rplacd cell (cdr (cdr cell)))
  624.          (setq shell-dirstack (cdr ds))
  625.          (shell-dirstack-message)))
  626.       (t
  627.        (error "Couldn't popd")))))
  628.  
  629. ;; Return DIR prefixed with comint-file-name-prefix as appropriate.
  630. (defun shell-prefixed-directory-name (dir)
  631.   (if (= (length comint-file-name-prefix) 0)
  632.       dir
  633.     (if (file-name-absolute-p dir)
  634.     ;; The name is absolute, so prepend the prefix.
  635.     (concat comint-file-name-prefix dir)
  636.       ;; For relative name we assume default-directory already has the prefix.
  637.       (expand-file-name dir))))
  638.  
  639. ;;; cd [dir]
  640. (defun shell-process-cd (arg)
  641.   (let ((new-dir (cond ((zerop (length arg)) (concat comint-file-name-prefix
  642.                              "~"))
  643.                ((string-equal "-" arg) shell-last-dir)
  644.                (t (shell-prefixed-directory-name arg)))))
  645.     (setq shell-last-dir default-directory)
  646.     (shell-cd-1 new-dir shell-dirstack)))
  647.  
  648. ;;; pushd [+n | dir]
  649. (defun shell-process-pushd (arg)
  650.   (let ((num (shell-extract-num arg)))
  651.     (cond ((zerop (length arg))
  652.        ;; no arg -- swap pwd and car of stack unless shell-pushd-tohome
  653.        (cond (shell-pushd-tohome
  654.           (shell-process-pushd (concat comint-file-name-prefix "~")))
  655.          (shell-dirstack
  656.           (let ((old default-directory))
  657.                     (shell-cd-1 (car shell-dirstack)
  658.                                 (cons old (cdr shell-dirstack)))))
  659.                  (t
  660.                   (message "Directory stack empty."))))
  661.       ((numberp num)
  662.        ;; pushd +n
  663.            (cond ((> num (length shell-dirstack))
  664.                   (message "Directory stack not that deep."))
  665.                  ((= num 0)
  666.           (error (message "Couldn't cd.")))
  667.          (shell-pushd-dextract
  668.           (let ((dir (nth (1- num) shell-dirstack)))
  669.             (shell-process-popd arg)
  670.             (shell-process-pushd default-directory)
  671.             (shell-cd-1 dir shell-dirstack)))
  672.                  (t
  673.                   (let* ((ds (cons default-directory shell-dirstack))
  674.                          (dslen (length ds))
  675.                          (front (nthcdr num ds))
  676.                          (back (reverse (nthcdr (- dslen num) (reverse ds))))
  677.                          (new-ds (append front back)))
  678.                     (shell-cd-1 (car new-ds) (cdr new-ds))))))
  679.       (t
  680.            ;; pushd <dir>
  681.            (let ((old-wd default-directory))
  682.              (shell-cd-1 (shell-prefixed-directory-name arg)
  683.                          (if (or (null shell-pushd-dunique)
  684.                                  (not (member old-wd shell-dirstack)))
  685.                              (cons old-wd shell-dirstack)
  686.                              shell-dirstack)))))))
  687.  
  688. ;; If STR is of the form +n, for n>0, return n. Otherwise, nil.
  689. (defun shell-extract-num (str)
  690.   (and (string-match "^\\+[1-9][0-9]*$" str)
  691.        (string-to-int str)))
  692.  
  693.  
  694. (defun shell-dirtrack-toggle ()
  695.   "Turn directory tracking on and off in a shell buffer."
  696.   (interactive)
  697.   (if (setq shell-dirtrackp (not shell-dirtrackp))
  698.       (setq list-buffers-directory default-directory)
  699.     (setq list-buffers-directory nil))
  700.   (message "Directory tracking %s" (if shell-dirtrackp "ON" "OFF")))
  701.  
  702. ;;; For your typing convenience:
  703. ;; XEmacs: removed this because then `M-x dir' doesn't complete to `dired'
  704. ;;(define-function 'dirtrack-toggle 'shell-dirtrack-toggle)
  705.  
  706. (defun shell-cd (dir)
  707.   "Do normal `cd' to DIR, and set `list-buffers-directory'."
  708.   (if shell-dirtrackp
  709.       (setq list-buffers-directory (file-name-as-directory
  710.                     (expand-file-name dir))))
  711.   (cd dir))
  712.  
  713. (defun shell-resync-dirs ()
  714.   "Resync the buffer's idea of the current directory stack.
  715. This command queries the shell with the command bound to 
  716. `shell-dirstack-query' (default \"dirs\"), reads the next
  717. line output and parses it to form the new directory stack.
  718. DON'T issue this command unless the buffer is at a shell prompt.
  719. Also, note that if some other subprocess decides to do output
  720. immediately after the query, its output will be taken as the
  721. new directory stack -- you lose. If this happens, just do the
  722. command again."
  723.   (interactive)
  724.   (let* ((proc (get-buffer-process (current-buffer)))
  725.      (pmark (process-mark proc)))
  726.     (goto-char pmark)
  727.     (insert shell-dirstack-query) (insert "\n")
  728.     (sit-for 0) ; force redisplay
  729.     (comint-send-string proc shell-dirstack-query) 
  730.     (comint-send-string proc "\n")
  731.     (set-marker pmark (point))
  732.     (let ((pt (point))) ; wait for 1 line
  733.       ;; This extra newline prevents the user's pending input from spoofing us.
  734.       (insert "\n") (backward-char 1)
  735.       (while (not (looking-at ".+\n"))
  736.     (accept-process-output proc)
  737.     (goto-char pt)
  738.     ;; kludge to cope with shells that have "stty echo" turned on.
  739.     ;; of course this will lose if there is only one dir on the stack
  740.     ;; and it is named "dirs"...  -jwz
  741.     (if (looking-at "^dirs\r?\n") (delete-region (point) (match-end 0)))
  742.     ))
  743.     (goto-char pmark) (delete-char 1) ; remove the extra newline
  744.     ;; That's the dirlist. grab it & parse it.
  745.     (let* ((dl (buffer-substring (match-beginning 0) (1- (match-end 0))))
  746.        (dl-len (length dl))
  747.        (ds '())            ; new dir stack
  748.        (i 0))
  749.       (while (< i dl-len)
  750.     ;; regexp = optional whitespace, (non-whitespace), optional whitespace
  751.     (string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir
  752.     (setq ds (cons (concat comint-file-name-prefix
  753.                    (substring dl (match-beginning 1)
  754.                       (match-end 1)))
  755.                ds))
  756.     (setq i (match-end 0)))
  757.       (let ((ds (reverse ds)))
  758.         (shell-cd-1 (car ds) (cdr ds))))))
  759.  
  760. ;;; For your typing convenience:
  761. ;; XEmacs: removed this because then `M-x dir' doesn't complete to `dired'
  762. ;(define-function 'dirs 'shell-resync-dirs)
  763.  
  764. ;; XEmacs addition
  765. (defvar shell-dirstack-message-hook nil
  766.   "Hook to run after a cd, pushd or popd event")
  767.  
  768. ;;; Show the current dirstack on the message line.
  769. ;;; Pretty up dirs a bit by changing "/usr/jqr/foo" to "~/foo".
  770. ;;; (This isn't necessary if the dirlisting is generated with a simple "dirs".)
  771. ;;; All the commands that mung the buffer's dirstack finish by calling
  772. ;;; this guy.
  773. (defun shell-dirstack-message ()
  774.   (let* ((msg "")
  775.          (ds (cons default-directory shell-dirstack))
  776.          (home (format "^%s\\(/\\|$\\)" (regexp-quote (getenv "HOME"))))
  777.          (prefix (and comint-file-name-prefix
  778.               ;; XEmacs addition: don't turn "/foo" into "foo" !!
  779.               (not (= 0 (length comint-file-name-prefix)))
  780.                       (format "^%s\\(/\\|$\\)"
  781.                               (regexp-quote comint-file-name-prefix)))))
  782.     (while ds
  783.       (let ((dir (car ds)))
  784.     (if (string-match home dir)
  785.         (setq dir (concat "~/" (substring dir (match-end 0)))))
  786.     ;; Strip off comint-file-name-prefix if present.
  787.     (and prefix (string-match prefix dir)
  788.          (setq dir (substring dir (match-end 0)))
  789.              (setcar ds dir)
  790.              )
  791.     (setq msg (concat msg dir " "))
  792.     (setq ds (cdr ds))))
  793.     ;; XEmacs change
  794.     (run-hooks 'shell-dirstack-message-hook)
  795.     (message msg)))
  796.  
  797.  
  798. (defun shell-forward-command (&optional arg)
  799.   "Move forward across ARG shell command(s).  Does not cross lines.
  800. See `shell-command-regexp'."
  801.   (interactive "p")
  802.   (let ((limit (save-excursion (end-of-line nil) (point))))
  803.     (if (re-search-forward (concat shell-command-regexp "\\([;&|][\t ]*\\)+")
  804.                limit 'move arg)
  805.     (skip-syntax-backward " "))))
  806.  
  807.  
  808. (defun shell-backward-command (&optional arg)
  809.   "Move backward across ARG shell command(s).  Does not cross lines.
  810. See `shell-command-regexp'."
  811.   (interactive "p")
  812.   (let ((limit (save-excursion (comint-bol nil) (point))))
  813.     (if (> limit (point))
  814.     (save-excursion (beginning-of-line) (setq limit (point))))
  815.     (skip-syntax-backward " " limit)
  816.     (if (re-search-backward
  817.      (format "[;&|]+[\t ]*\\(%s\\)" shell-command-regexp) limit 'move arg)
  818.     (progn (goto-char (match-beginning 1))
  819.            (skip-chars-forward ";&|")))))
  820.  
  821.  
  822. (defun shell-dynamic-complete-command ()
  823.   "Dynamically complete the command at point.
  824. This function is similar to `comint-dynamic-complete-filename', except that it
  825. searches `exec-path' (minus the trailing emacs library path) for completion
  826. candidates.  Note that this may not be the same as the shell's idea of the
  827. path.
  828.  
  829. Completion is dependent on the value of `shell-completion-execonly', plus
  830. those that effect file completion.  See `shell-dynamic-complete-as-command'.
  831.  
  832. Returns t if successful."
  833.   (interactive)
  834.   (let ((filename (comint-match-partial-filename)))
  835.     (if (and filename
  836.          (save-match-data (not (string-match "[~/]" filename)))
  837.          (eq (match-beginning 0)
  838.          (save-excursion (shell-backward-command 1) (point))))
  839.     (prog2 (message "Completing command name...")
  840.         (shell-dynamic-complete-as-command)))))
  841.  
  842.  
  843. (defun shell-dynamic-complete-as-command ()
  844.   "Dynamically complete at point as a command.
  845. See `shell-dynamic-complete-filename'.  Returns t if successful."
  846.   (let* ((filename (or (comint-match-partial-filename) ""))
  847.      (pathnondir (file-name-nondirectory filename))
  848.      (paths (cdr (reverse exec-path)))
  849.      (cwd (file-name-as-directory (expand-file-name default-directory)))
  850.      (ignored-extensions
  851.       (and comint-completion-fignore
  852.            (mapconcat (function (lambda (x) (concat (regexp-quote x) "$")))
  853.               comint-completion-fignore "\\|")))
  854.      (path "") (comps-in-path ()) (file "") (filepath "") (completions ()))
  855.     ;; Go thru each path in the search path, finding completions.
  856.     (while paths
  857.       (setq path (file-name-as-directory (comint-directory (or (car paths) ".")))
  858.         comps-in-path (and (file-accessible-directory-p path)
  859.                    (file-name-all-completions pathnondir path)))
  860.       ;; Go thru each completion found, to see whether it should be used.
  861.       (while comps-in-path
  862.     (setq file (car comps-in-path)
  863.           filepath (concat path file))
  864.     (if (and (not (member file completions))
  865.          (not (and ignored-extensions
  866.                (string-match ignored-extensions file)))
  867.          (or (string-equal path cwd)
  868.              (not (file-directory-p filepath)))
  869.          (or (null shell-completion-execonly)
  870.              (file-executable-p filepath)))
  871.         (setq completions (cons file completions)))
  872.     (setq comps-in-path (cdr comps-in-path)))
  873.       (setq paths (cdr paths)))
  874.     ;; OK, we've got a list of completions.
  875.     (let ((success (let ((comint-completion-addsuffix nil))
  876.              (comint-dynamic-simple-complete pathnondir completions))))
  877.       (if (and (memq success '(sole shortest)) comint-completion-addsuffix
  878.            (not (file-directory-p (comint-match-partial-filename))))
  879.       (insert " "))
  880.       success)))
  881.  
  882.  
  883. (defun shell-match-partial-variable ()
  884.   "Return the variable at point, or nil if non is found."
  885.   (save-excursion
  886.     (let ((limit (point)))
  887.       (if (re-search-backward "[^A-Za-z0-9_{}]" nil 'move)
  888.       (or (looking-at "\\$") (forward-char 1)))
  889.       ;; Anchor the search forwards.
  890.       (if (or (eolp) (looking-at "[^A-Za-z0-9_{}$]"))
  891.       nil
  892.     (re-search-forward "\\$?{?[A-Za-z0-9_]*}?" limit)
  893.     (buffer-substring (match-beginning 0) (match-end 0))))))
  894.  
  895.  
  896. (defun shell-dynamic-complete-environment-variable ()
  897.   "Dynamically complete the environment variable at point.
  898. Completes if after a variable, i.e., if it starts with a \"$\".
  899. See `shell-dynamic-complete-as-environment-variable'.
  900.  
  901. This function is similar to `comint-dynamic-complete-filename', except that it
  902. searches `process-environment' for completion candidates.  Note that this may
  903. not be the same as the interpreter's idea of variable names.  The main problem
  904. with this type of completion is that `process-environment' is the environment
  905. which Emacs started with.  Emacs does not track changes to the environment made
  906. by the interpreter.  Perhaps it would be more accurate if this function was
  907. called `shell-dynamic-complete-process-environment-variable'.
  908.  
  909. Returns non-nil if successful."
  910.   (interactive)
  911.   (let ((variable (shell-match-partial-variable)))
  912.     (if (and variable (string-match "^\\$" variable))
  913.     (prog2 (message "Completing variable name...")
  914.         (shell-dynamic-complete-as-environment-variable)))))
  915.  
  916.  
  917. (defun shell-dynamic-complete-as-environment-variable ()
  918.   "Dynamically complete at point as an environment variable.
  919. Used by `shell-dynamic-complete-environment-variable'.
  920. Uses `comint-dynamic-simple-complete'."
  921.   (let* ((var (or (shell-match-partial-variable) ""))
  922.      (variable (substring var (or (string-match "[^$({]\\|$" var) 0)))
  923.      (variables (mapcar (function (lambda (x)
  924.                     (substring x 0 (string-match "=" x))))
  925.                 process-environment))
  926.      (addsuffix comint-completion-addsuffix)
  927.      (comint-completion-addsuffix nil)
  928.      (success (comint-dynamic-simple-complete variable variables)))
  929.     (if (memq success '(sole shortest))
  930.     (let* ((var (shell-match-partial-variable))
  931.            (variable (substring var (string-match "[^$({]" var)))
  932.            (protection (cond ((string-match "{" var) "}")
  933.                  ((string-match "(" var) ")")
  934.                  (t "")))
  935.            (suffix (cond ((null addsuffix) "")
  936.                  ((file-directory-p
  937.                    (comint-directory (getenv variable))) "/")
  938.                  (t " "))))
  939.       (insert protection suffix)))
  940.     success))
  941.  
  942.  
  943. (defun shell-replace-by-expanded-directory ()
  944.   "Expand directory stack reference before point.
  945. Directory stack references are of the form \"=digit\" or \"=-\".
  946. See `default-directory' and `shell-dirstack'.
  947.  
  948. Returns t if successful."
  949.   (interactive)
  950.   (if (comint-match-partial-filename)
  951.       (save-excursion
  952.     (goto-char (match-beginning 0))
  953.     (let ((stack (cons default-directory shell-dirstack))
  954.           (index (cond ((looking-at "=-/?")
  955.                 (length shell-dirstack))
  956.                ((looking-at "=\\([0-9]+\\)")
  957.                 (string-to-number
  958.                  (buffer-substring
  959.                   (match-beginning 1) (match-end 1)))))))
  960.       (cond ((null index)
  961.          nil)
  962.         ((>= index (length stack))
  963.          (error "Directory stack not that deep."))
  964.         (t
  965.          (replace-match (file-name-as-directory (nth index stack)) t t)
  966.          (message "Directory item: %d" index)
  967.          t))))))
  968.  
  969. (provide 'shell)
  970.  
  971. ;;; shell.el ends here
  972.